home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / UTILITY1 / MSWSRC35.ZIP / WRKSP.CPP < prev    next >
C/C++ Source or Header  |  1993-09-19  |  24KB  |  1,026 lines
  1. /*
  2.  *      wrksp.c         logo workspace management module                dvb
  3.  *
  4.  *    Copyright (C) 1989 The Regents of the University of California
  5.  *    This Software may be copied and distributed for educational,
  6.  *    research, and not for profit purposes provided that this
  7.  *    copyright and statement are included in all such copies.
  8.  *
  9.  */
  10.  
  11. #include "logo.h"
  12. #include "globals.h"
  13. #ifdef ibm
  14. #include "process.h"
  15. #endif
  16.  
  17. char *editor, *editorname;
  18. int to_pending = 0;
  19.  
  20. NODE *make_procnode(NODE *lst, NODE *wrds, short min, short df, short max)
  21. {
  22.     return(cons_list(0, lst, wrds, make_intnode((FIXNUM)min),
  23.              make_intnode((FIXNUM)df), make_intnode((FIXNUM)max),
  24.              END_OF_LIST));
  25. }
  26.  
  27. NODE *get_bodywords(NODE *proc, NODE *name)
  28. {
  29.     NODE *val = bodywords__procnode(proc);
  30.     NODE *head = NIL, *tail = NIL;
  31.  
  32.     if (val != NIL) return(val);
  33.     name = intern(name);
  34.     head = cons_list(0, (is_macro(name) ? Macro : To), name, END_OF_LIST);
  35.     tail = cdr(head);
  36.     val = formals__procnode(proc);
  37.     while (val != NIL) {
  38.     if (is_list(car(val)))
  39.         setcdr(tail, cons(cons(make_colon(caar(val)), cdar(val)), NIL));
  40.     else if (nodetype(car(val)) == INT)
  41.         setcdr(tail, cons(car(val),NIL));
  42.     else
  43.         setcdr(tail, cons(make_colon(car(val)),NIL));
  44.     tail = cdr(tail);
  45.     val = cdr(val);
  46.     }
  47.     head = cons(head, NIL);
  48.     tail = head;
  49.     val = bodylist__procnode(proc);
  50.     while (val != NIL) {
  51.     setcdr(tail, cons(car(val), NIL));
  52.     tail = cdr(tail);
  53.     val = cdr(val);
  54.     }
  55.     setcdr(tail, cons(End, NIL));
  56.     setbodywords__procnode(proc,head);
  57.     return(head);
  58. }
  59.  
  60. NODE *name_arg(NODE *args) {
  61.     while (aggregate(car(args)) && NOT_THROWING)
  62.     setcar(args, err_logo(BAD_DATA, car(args)));
  63.     return car(args);
  64. }
  65.  
  66. NODE *ltext(NODE *args)
  67. {
  68.     NODE *name, *val = UNBOUND;
  69.  
  70.     name = name_arg(args);
  71.     if (NOT_THROWING) {
  72.     val = procnode__caseobj(intern(name));
  73.     if (val == UNDEFINED) {
  74.         err_logo(DK_HOW_UNREC,name);
  75.         return UNBOUND;
  76.     } else if (is_prim(val)) {
  77.         err_logo(IS_PRIM,name);
  78.         return UNBOUND;
  79.     } else 
  80.         return text__procnode(val);
  81.     }
  82.     return UNBOUND;
  83. }
  84.  
  85. NODE *lfulltext(NODE *args)
  86. {
  87.     NODE *name, *val = UNBOUND;
  88.  
  89.     name = name_arg(args);
  90.     if (NOT_THROWING) {
  91.     val = procnode__caseobj(intern(name));
  92.     if (val == UNDEFINED) {
  93.         err_logo(DK_HOW_UNREC,name);
  94.         return UNBOUND;
  95.     } else if (is_prim(val)) {
  96.         err_logo(IS_PRIM,name);
  97.         return UNBOUND;
  98.     } else 
  99.         return get_bodywords(val,name);
  100.     }
  101.     return UNBOUND;
  102. }
  103.  
  104. NODE *define_helper(NODE *args, BOOLEAN macro_flag)
  105. {
  106.     NODE *name, *val, *arg = NIL;
  107.     int minimum = 0, deflt = 0, maximum = 0, old_default = -1;
  108.     int redef = (compare_node(valnode__caseobj(Redefp),Truex,TRUE) == 0);
  109.  
  110.     name = name_arg(args);
  111.     if (NOT_THROWING) {
  112.     name = intern(name);
  113.     val = procnode__caseobj(name);
  114.     if (!redef && is_prim(val)) {
  115.         err_logo(IS_PRIM,name);
  116.         return UNBOUND;
  117.     } else if (val != UNDEFINED) {
  118.         old_default = getint(dfltargs__procnode(val));
  119.     }
  120.     }
  121.     if (NOT_THROWING) {
  122.     val = cadr(args);
  123.     while ((val == NIL || !is_list(val) || !is_list(car(val))) &&
  124.             NOT_THROWING) {
  125.         setcar(cdr(args), err_logo(BAD_DATA, val));
  126.         val = cadr(args);
  127.     }
  128.     }
  129.     if (NOT_THROWING) {
  130.     args = car(val);
  131.     if (args != NIL) {
  132.         make_runparse(args);
  133.         args = parsed__runparse(args);
  134.     }
  135.     setcar(val, args);
  136.     while (args != NIL) {
  137.         arg = car(args);
  138.         if (arg != NIL && is_list(arg) && maximum != -1) {
  139.         make_runparse(arg);
  140.         arg = parsed__runparse(arg);
  141.         setcar(args, arg);
  142.         maximum++;
  143.         if (cdr(arg) == NIL)
  144.             maximum = -1;
  145.         } else if (nodetype(arg) == INT &&
  146.                getint(arg) <= (unsigned) maximum &&
  147.                getint(arg) >= minimum) {
  148.         deflt = getint(arg);
  149.         } else if (maximum == minimum) {
  150.         minimum++;
  151.         maximum++;
  152.         deflt++;
  153.         } else {
  154.         err_logo(BAD_DATA_UNREC, arg);
  155.         break;
  156.         }
  157.         args = cdr(args);
  158.         if (check_throwing) break;
  159.     }
  160.     }
  161.     if (NOT_THROWING) {
  162.     setprocnode__caseobj(name,
  163.                  make_procnode(val, NIL, minimum, deflt, maximum));
  164.     if (macro_flag)
  165.         setflag__caseobj(name, PROC_MACRO);
  166.     else
  167.         clearflag__caseobj(name, PROC_MACRO);
  168.     if (deflt != old_default && old_default >= 0) {
  169.         the_generation = reref(the_generation, cons(NIL, NIL));
  170.     }
  171.     }
  172.     return(UNBOUND);
  173. }
  174.  
  175. NODE *ldefine(NODE *args)
  176. {
  177.     return define_helper(args, FALSE);
  178. }
  179.  
  180. NODE *ldefmacro(NODE *args)
  181. {
  182.     return define_helper(args, TRUE);
  183. }
  184.  
  185. NODE *to_helper(NODE *args, BOOLEAN macro_flag)
  186. {
  187.     NODE *arg = NIL, *tnode = NIL, *proc_name, *formals = NIL, *lastnode = NIL,
  188.      *body_words, *lastnode2, *body_list, *ttnode = NIL;
  189.     int minimum = 0, deflt = 0, maximum = 0, old_default = -1;
  190.     char ttemp[16];
  191.  
  192.     if (ufun != NIL && loadstream == stdin) {
  193.     err_logo(NOT_INSIDE,NIL);
  194.     return(UNBOUND);
  195.     }
  196.  
  197.     if (args == NIL) {
  198.     err_logo(NOT_ENOUGH,NIL);
  199.     return(UNBOUND);
  200.     }
  201.  
  202.     proc_name = car(args);
  203.     args = cdr(args);
  204.  
  205.     if (nodetype(proc_name) != CASEOBJ)
  206.     err_logo(BAD_DATA_UNREC, proc_name);
  207.     else if ((procnode__caseobj(proc_name) != UNDEFINED && loadstream == stdin)
  208.          || is_prim(procnode__caseobj(proc_name)))
  209.     err_logo(ALREADY_DEFINED, proc_name);
  210.     else {
  211.     NODE *old_proc = procnode__caseobj(proc_name);
  212.     if (old_proc != UNDEFINED) {
  213.         old_default = getint(dfltargs__procnode(old_proc));
  214.     }
  215.     while (args != NIL) {
  216.         arg = car(args);
  217.         args = cdr(args);
  218.         if (nodetype(arg) == CONS && maximum != -1) {
  219.         make_runparse(arg);
  220.         arg = parsed__runparse(arg);
  221.         maximum++;
  222.         if (nodetype(car(arg)) != COLON) {
  223.             err_logo(BAD_DATA_UNREC, arg);
  224.             break;
  225.         } else
  226.             setcar(arg, node__colon(car(arg)));
  227.         if (cdr(arg) == NIL)
  228.             maximum = -1;
  229.         } else if (nodetype(arg) == COLON && maximum == minimum) {
  230.         arg = node__colon(arg);
  231.         minimum++;
  232.         maximum++;
  233.         deflt++;
  234.         } else if (nodetype(arg) == INT && 
  235.                getint(arg) <= (unsigned) maximum &&
  236.                getint(arg) >= minimum) {
  237.         deflt = getint(arg);
  238.         } else {
  239.         err_logo(BAD_DATA_UNREC, arg);
  240.         break;
  241.         }
  242.         tnode = cons(arg, NIL);
  243.         if (formals == NIL) formals = tnode;
  244.         else setcdr(lastnode, tnode);
  245.         lastnode = tnode;
  246.     }
  247.     }
  248.  
  249.     if (NOT_THROWING) {
  250.     body_words = cons(current_line, NIL);
  251.     lastnode2 = body_words;
  252.     body_list = cons(formals, NIL);
  253.     lastnode = body_list;
  254.     to_pending++;    /* for int or quit signal */
  255.     while (NOT_THROWING && to_pending && (!feof(loadstream))) {
  256.             strcpy(ttemp,"> ");
  257.             ttnode = reader(loadstream, ttemp);
  258.         tnode = cons(ttnode, NIL);
  259.         setcdr(lastnode2, tnode);
  260.         lastnode2 = tnode;
  261.         tnode = cons(parser(car(tnode), TRUE), NIL);
  262.         if (car(tnode) != NIL && compare_node(caar(tnode), End, TRUE) == 0)
  263.         break;
  264.         else if (car(tnode) != NIL) {
  265.         setcdr(lastnode, tnode);
  266.         lastnode = tnode;
  267.         }
  268.     }
  269.     if (to_pending && NOT_THROWING) {
  270.         setprocnode__caseobj(proc_name,
  271.                  make_procnode(body_list, body_words, minimum,
  272.                            deflt, maximum));
  273.         if (macro_flag)
  274.         setflag__caseobj(proc_name, PROC_MACRO);
  275.         else
  276.         clearflag__caseobj(proc_name, PROC_MACRO);
  277.         if (deflt != old_default && old_default >= 0) {
  278.         the_generation = reref(the_generation,
  279.                cons(NIL, NIL));
  280.         }
  281.         if (loadstream == stdin) {
  282.         ndprintf(stdout, "%s defined\n", proc_name);
  283.         }
  284.     }
  285.     to_pending = 0;
  286.     }
  287.     return(UNBOUND);
  288. }
  289.  
  290. NODE *lto(NODE *args)
  291. {
  292.     NODE *temp_node;
  293.  
  294.     IsDirty = 1;
  295.     input_mode = TO_MODE;
  296.     temp_node = to_helper(args, FALSE);
  297.     input_mode = NO_MODE;
  298.     return (temp_node);
  299. }
  300.  
  301. NODE *lmacro(NODE *args)
  302. {
  303.     return to_helper(args, TRUE);
  304. }
  305.  
  306. NODE *lmake(NODE *args)
  307. {
  308.     NODE *what;
  309.  
  310.     what = name_arg(args);
  311.     if (NOT_THROWING) {
  312.     what = intern(what);
  313.     setvalnode__caseobj(what, cadr(args));
  314.     if (flag__caseobj(what, VAL_TRACED)) {
  315.         NODE *tvar = maybe_quote(cadr(args));
  316.         ndprintf(writestream, "Make %s %s", make_quote(w